home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / FIG.I < prev    next >
Text File  |  1991-12-14  |  27KB  |  852 lines
  1. IMPLEMENTATION MODULE FIG ;
  2.  
  3. (*
  4.    Versuch, ein bereits fertiges FIG-File zu interpretieren
  5.    und die Objekte zu übernehmen. Quick'n Dirty-Version.
  6.    Verbesserungen überall möglich und nötig... (JP)
  7.  
  8.    Dieses Modul ist (C)'91 by Jens Pirnay
  9. *)
  10.  
  11. FROM Dialoge         IMPORT BusyStart, BusyEnd;
  12. FROM Diverses        IMPORT GetFSelText, NumAlert, min, max;
  13. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close,
  14.                             ReadChar, UnixLine, ReadLn, AgainLine;
  15. FROM ObjectUtilities IMPORT FillObject;
  16. FROM Types           IMPORT DrawObjectTyp, TextPosTyp,
  17.                             ExtendedArraySize, CharArraySize,
  18.                             CodeAryTyp, ObjectPtrTyp;
  19. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR ;
  20. FROM Storage         IMPORT ALLOCATE , DEALLOCATE ;
  21. IMPORT CommonData ;
  22. IMPORT GetFile;
  23. IMPORT MathLib0 ;
  24. IMPORT MagicConvert ;
  25. IMPORT MagicDOS ;
  26. IMPORT MagicStrings ;
  27. IMPORT MagicSys ;
  28. IMPORT Variablen ;
  29. IMPORT mtAlerts;
  30. FROM VectorFont IMPORT LoadFont, TextWidth, TextHeight, SetTextStyle,
  31.                        SetFont, OutText,  CreateText;
  32. (**
  33. IMPORT RTD;
  34. **)
  35.  
  36. TYPE  chset = SET OF CHAR;
  37. CONST
  38.       Magic            = -29564;   (* Test auf ungültige Zahl *)
  39.       FMagic           = -29564.0; (* Test auf ungültige Zahl *)
  40.       Integers         = chset{'0'..'9','+','-'};
  41.       Reals            = chset{'0'..'9','+','-','.'};
  42.  
  43.       SolidLine        = 0;
  44.       DashLine         = 1;
  45.       DottedLine       = 2;
  46.  
  47.       OEllipse         = 1;
  48.       TEllipseByRad    = 1;
  49.       TEllipseByDia    = 2;
  50.       TCircleByRad     = 3;
  51.       TCircleByDia     = 4;
  52.  
  53.       OPolyline        = 2;
  54.       TPolyline        = 1;
  55.       TBox             = 2;
  56.       TPolygon         = 3;
  57.       TArcBox          = 4;
  58.  
  59.       OSpline          = 3;
  60.       TOpenNormal      = 1;
  61.       TClosedNormal    = 2;
  62.       TOpenInterpol    = 3;
  63.       TClosedInterpol  = 4;
  64.  
  65.       OText            = 4;
  66.       TLeftJustified   = 0;
  67.       TCenterJustified = 1;
  68.       TRightJustified  = 2;
  69.  
  70.       OArc             = 5;
  71.       T3PointArc       = 1;
  72.  
  73.       OCompound        = 6;
  74.  
  75.       OEndCompound     = -6;
  76.  
  77.  
  78. VAR   Filehandle : INTEGER;
  79.  
  80. PROCEDURE ExtractNumber(VAR str : ARRAY OF CHAR) : INTEGER;
  81. VAR i, j, res : INTEGER;
  82.     temp      : ARRAY [0..19] OF CHAR;
  83. BEGIN
  84. (**
  85.   RTD.Write('EN-In', str);
  86. **)
  87.   res := Magic;
  88.   (* Zunächst Spaces weg *)
  89.   i := 0;
  90.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  91.   temp := '';
  92.   j := 0;
  93.   WHILE str[i] IN Integers DO
  94.     temp[j] := str[i];
  95.     INC(i);
  96.     INC(j);
  97.   END;
  98.   temp[j] := 0C;
  99.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  100.   IF i>0 THEN
  101.     MagicStrings.Delete(str, 0, i);
  102.   END;
  103. (**
  104.   RTD.Write('EN-temp', temp);
  105. **)
  106.   IF temp[0]<>0C THEN
  107.     res := MagicConvert.StrToInt(temp);
  108.   END;
  109. (**
  110.   RTD.Write('EN-Out', str);
  111. **)
  112.   RETURN res;
  113. END ExtractNumber;
  114.  
  115. PROCEDURE ExtractFloat(VAR str : ARRAY OF CHAR) : LONGREAL;
  116. VAR i, j : INTEGER;
  117.     res  : LONGREAL;
  118.     temp : ARRAY [0..19] OF CHAR;
  119. BEGIN
  120. (**
  121.   RTD.Write('EF-In', str);
  122. **)
  123.   res := FMagic;
  124.   (* Zunächst Spaces weg *)
  125.   i := 0;
  126.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  127.   temp := '';
  128.   j := 0;
  129.   WHILE str[i] IN Reals DO
  130.     temp[j] := str[i];
  131.     INC(i);
  132.     INC(j);
  133.   END;
  134.   temp[j] := 0C;
  135.   WHILE (str[i]=' ') OR (str[i] = 07C) DO INC(i); END;
  136.   IF i>0 THEN
  137.     MagicStrings.Delete(str, 0, i);
  138.   END;
  139. (**
  140.   RTD.Write('EF-temp', temp);
  141. **)
  142.   IF temp[0]<>0C THEN
  143.     res := MagicConvert.StrToReal(temp);
  144.   END;
  145. (**
  146.   RTD.Write('EF-Out', str);
  147. **)
  148.   RETURN res;
  149. END ExtractFloat;
  150.  
  151. PROCEDURE ParseFile(name : ARRAY OF CHAR) : BOOLEAN;
  152. TYPE chset     = SET OF CHAR;
  153. VAR i          : INTEGER;
  154.     ok, first  : BOOLEAN;
  155.     upperleft  : BOOLEAN;
  156.     forwarrow  : BOOLEAN;
  157.     backwarrow : BOOLEAN;
  158.     pixperinch : INTEGER;
  159.     c          : CHAR;
  160.     str, num   : ARRAY [0..255] OF CHAR;
  161.     intArray   : ARRAY [1..19] OF INTEGER;
  162.     forwArray  : ARRAY [1..5] OF INTEGER;
  163.     backwArray : ARRAY [1..5] OF INTEGER;
  164.     realArray  : ARRAY [1..19] OF LONGREAL;
  165.     charBuffer : ARRAY [0..255] OF CHAR;
  166.     Code       : CodeAryTyp;
  167.     obj        : ObjectPtrTyp;
  168.     Surround   : ARRAY [0..3] OF INTEGER;
  169.     wx         : INTEGER ;
  170.     wy         : INTEGER ;
  171.     ww         : INTEGER ;
  172.     wh         : INTEGER ;
  173.     dum        : INTEGER ;
  174.     pos        : CARDINAL;
  175.     Version    : CARDINAL;
  176.     maxx, minx,
  177.     maxy, miny : INTEGER;
  178.     MinX, MinY : INTEGER;
  179.     deltaX,
  180.     deltaY     : INTEGER;
  181.  
  182.     (* Allgemein gilt:
  183.        Falls forw_arrow = 1, so folgt eine Zeile:
  184.        %da1 %da2 %da3 %da4 %da5                   (5)
  185.        %da1 : arrow_type
  186.        %da2 : arrow_style
  187.        %da3 : arrow_thickness
  188.        %da4 : arrow_width
  189.        %da5 : arrow_height
  190.        Falls backw_arrow = 1, ebenfalls.
  191.     *)
  192.  
  193.     PROCEDURE GetLine;
  194.     BEGIN
  195.       str[0] := 0C;
  196.       IF NOT EOF THEN
  197.         ReadLn (Filehandle, str);
  198.       END;
  199.     END GetLine;
  200.  
  201.     PROCEDURE GetNewLine;
  202.     BEGIN
  203.       REPEAT
  204.         GetLine;
  205.       UNTIL str[0] <> '#';
  206.     END GetNewLine;
  207.  
  208.     PROCEDURE ScanStr(Format : ARRAY OF CHAR);
  209.     VAR i, nrint, nrreal : INTEGER;
  210.     BEGIN
  211. (*
  212.       RTD.Write('ToScan', Format);
  213. *)
  214.       FOR i := 1 TO 19 DO
  215.         intArray [i] :=  Magic;
  216.         realArray[i] := FMagic;
  217.       END;
  218.       nrint  := 0;
  219.       nrreal := 0;
  220.       FOR i := 0 TO MagicSys.CastToInt(MagicStrings.Length(Format))-1 DO
  221.         IF (Format[i] = 'd') THEN
  222.           INC(nrint);
  223.           intArray[nrint] := ExtractNumber(str);
  224.         END;
  225.         IF (Format[i] = 'f') THEN
  226.           INC(nrreal);
  227.           realArray[nrreal] := ExtractFloat(str);
  228.         END;
  229.       END;
  230.       i := nrint + nrreal;
  231. (*
  232.       RTD.ShowVar('Scanned', i);
  233. *)
  234.     END ScanStr;
  235.  
  236.     PROCEDURE Coord(integer : INTEGER) : INTEGER;
  237.     BEGIN
  238.       IF upperleft THEN
  239.         RETURN -integer;
  240.        ELSE
  241.         RETURN integer;
  242.       END;
  243.     END Coord;
  244.  
  245.     PROCEDURE CheckArrow(forw, backw : INTEGER);
  246.     VAR i : INTEGER;
  247.     BEGIN
  248.       forwarrow  := intArray[forw] =1;
  249.       backwarrow := intArray[backw]=1;
  250.       IF forwarrow THEN
  251.         GetNewLine;
  252.         FOR i:=1 TO 5 DO
  253.           forwArray[i] := ExtractNumber(str);
  254.         END;
  255.       END;
  256.       IF backwarrow THEN
  257.         GetNewLine;
  258.         FOR i:=1 TO 5 DO
  259.           backwArray[i] := ExtractNumber(str);
  260.         END;
  261.       END;
  262.     END CheckArrow;
  263.  
  264.     PROCEDURE InitCode;
  265.     VAR i : INTEGER;
  266.     BEGIN
  267.       FOR i := 0 TO 9 DO Code[i] := 0; END;
  268.       FOR i := 0 TO 3 DO Surround[i] := 0; END;
  269.       Code[8] := 1; (* Thickness *)
  270.     END InitCode;
  271.  
  272.     PROCEDURE GetArc;
  273.     VAR IsArc : BOOLEAN;
  274.         startangle, deltaangle : INTEGER;
  275.         radx, rady             : INTEGER;
  276.     BEGIN
  277.       (* Format der Arc-Beschreibung:
  278.          %d01 %d02 %d03 %d04 %d05 %d06 %d07 %f01
  279.          %d08 %d09 %d10 %f02 %f03 %d11 %d12 %d13
  280.          %d14 %d15 %d16                           (19)
  281.          mit
  282.          %d01 : type            %d02 : line_style
  283.          %d03 : line_thickness  %d04 : color
  284.          %d05 : depth           %d06 : pen
  285.          %d07 : area_fill       %f01 : style_val
  286.          %d08 : direction       %d09 : forw_arrow
  287.          %d10 : backw_arrow     %f02 : center_x
  288.          %f03 : center_y        %d11 : x_1
  289.          %d12 : y_1             %d13 : x_2
  290.          %d14 : y_2             %d15 : x_3
  291.          %d16 : y_3
  292.       *)
  293.       ScanStr('dddddddfdddffdddddd');
  294.       CheckArrow(9, 10);
  295. (*
  296.       InitCode;
  297.       Code[1] := RealCoord(realArray[2]);
  298.       Code[2] := RealCoord(realArray[3]);
  299.       IF (intArray[1] = T3PointArc) THEN
  300.         IF IsArc THEN
  301.            Code[0] := ORD(Arc);
  302.            Code[3] := radx;
  303.            Code[4] := startangle;
  304.            Code[5] := deltaangle;
  305.            Variablen.NewObject(Code, NIL, NIL, Surround);
  306.            Variablen.LastObject^.SurrDirty := TRUE;
  307.           ELSE
  308.            Code[0] := ORD(Ellipse);
  309.            Code[3] := radx;
  310.            Code[4]